home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue43 / makemic / MAKEMIC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-12-21  |  9.2 KB  |  260 lines
  1. unit MAKEMIC;
  2.  
  3. { This unit defines the MakeMethodInstance,MakeMethodInstance32Reg and         }
  4. { FreeMethodInstance functions. $IFDEFs are used to tailor the unit to the     }
  5. { different versions of Delphi.                                                }
  6.  
  7. { Revised by Primoz Gabrijelcic and published in The Delphi Magazine, February 1999
  8.   Changes marked  by !! }
  9.  
  10. interface
  11.  
  12. uses WinTypes, WinProcs, SysUtils;
  13.  
  14. procedure FreeMethodInstance(Instance: Pointer);
  15. function MakeMethodInstance(Code,Data: Pointer): Pointer;
  16. {$IFDEF WIN32}
  17. function MakeMethodInstance32Reg(Code,Data: Pointer; OptCount: Integer): Pointer;
  18. {$ENDIF}
  19.  
  20. implementation
  21.  
  22. type
  23.   PJumpBlock = ^TJumpBlock;
  24.   TJumpBlock = packed record
  25. {$IFDEF WIN32}
  26.     POP_EAX_OpCode: Byte;
  27.     Push_Immed_OpCode: Byte;
  28.     Self_Value: Pointer;
  29.     PUSH_EAX_OpCode: Byte;
  30.     Jmp_OpCode: Byte;
  31.     Method_Addr: Pointer;
  32.     DummyAddr: Byte;
  33. {$ELSE}
  34.     POP_AX_OpCode: Byte;
  35.     POP_CX_OpCode: Byte;
  36.     Push_Seg_Immed_OpCode: Byte;
  37.     Self_Seg_Value: Word;
  38.     Push_Ofs_Immed_OpCode: Byte;
  39.     Self_Ofs_Value: Word;
  40.     PUSH_CX_OpCode: Byte;
  41.     PUSH_AX_OpCode: Byte;
  42.     Jmp_OpCode: Byte;
  43.     Method_Addr: Pointer;
  44.     { Specific information needed for 16 bit segmented memory }
  45.     DataSelector: THandle;
  46.     CodeSelector: THandle;
  47. {$ENDIF}
  48.   end;
  49.  
  50. function MakeMethodInstance(Code,Data: Pointer): Pointer;
  51. {$IFNDEF WIN32}
  52. var
  53.   WrkHData,WrkHCode: THandle;
  54. {$ENDIF}
  55.  
  56. begin
  57. {$IFDEF WIN32}
  58.   (* ORIGINAL VERSION:
  59.     Result := VirtualAlloc(nil,sizeof(TJumpBlock),MEM_COMMIT,PAGE_EXECUTE_READWRITE); *)
  60.   (!!* REVISED VERSION: *)
  61.   Result := VirtualAlloc(nil, sizeof(TJumpBlock), MEM_RESERVE OR MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  62.   if Result <> nil then
  63.     With PJumpBlock(Result)^ do
  64.       begin
  65.         POP_EAX_OpCode    := $58;    { POP Return address into EAX register }
  66.         Push_Immed_OpCode := $68;    { PUSH DWORD following this instruction }
  67.         Self_Value        := Data;   { Set DWORD to the object instance address }
  68.         PUSH_EAX_OpCode   := $50;    { Push the return address back on the stack }
  69.         Jmp_OpCode        := $E9;    { JMP to the relative offset following this opcode }
  70.         Method_Addr       := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  71.       end;
  72. {$ELSE}
  73.   WrkHData := GlobalAlloc(HeapAllocFlags,SizeOf(TJumpBlock));
  74.   Result := GlobalLock(WrkHData);
  75.   if Result <> nil then
  76.     With PJumpBlock(Result)^ do
  77.       begin
  78.         POP_AX_OpCode         := $58;    { POP Return address into EAX register }
  79.         POP_CX_OpCode         := $59;    { POP Return address into ECX register }
  80.         Push_Seg_Immed_OpCode := $68;    { PUSH the Self segment value onto stack }
  81.         Self_Seg_Value        := PtrRec(Data).Seg;
  82.         Push_Ofs_Immed_OpCode := $68;    { PUSH the Self segment offset onto stack }
  83.         Self_Ofs_Value        := PtrRec(Data).Ofs;
  84.         PUSH_CX_OpCode        := $51;    { PUSH the CX register back onto the stack }
  85.         PUSH_AX_OpCode        := $50;    { PUSH the AX register back onto the stack }
  86.         Jmp_OpCode            := $EA;    { JMP to the address following this opcode }
  87.         Method_Addr           := Code;
  88.         WrkHCode              := AllocDsToCSAlias(PtrRec(Result).Seg);
  89.         PtrRec(Result).Seg    := WrkHCode;
  90.         { Store the code and data selectors for FreeMethodInstance }
  91.         DataSelector          := WrkHData;
  92.         CodeSelector          := WrkHCode;
  93.       end;
  94. {$ENDIF}
  95. end;
  96.  
  97. procedure FreeMethodInstance(Instance: Pointer);
  98. {$IFNDEF WIN32}
  99. var
  100.   WrkHData,WrkHCode: THandle;
  101. {$ENDIF}
  102.  
  103. begin
  104. {$IFDEF WIN32}
  105.   if Instance <> nil then
  106.     (* ORIGINAL VERSION:
  107.     VirtualFree(Instance,0,MEM_DECOMMIT); *)
  108.     (*!! REVISED VERSION: *)
  109.     VirtualFree(Instance, 0, MEM_RELEASE);      
  110. {$ELSE}
  111.   if Instance <> nil then
  112.     With PJumpBlock(Instance)^ do
  113.       begin
  114.         WrkHData := DataSelector;
  115.         WrkHCode := CodeSelector;
  116.         GlobalUnlock(WrkHData);
  117.         GlobalFree(WrkHData);
  118.         FreeSelector(WrkHCode);
  119.       end;
  120. {$ENDIF}
  121. end;
  122.  
  123. {==============================================================================}
  124. { All code following this comment is only available in Delphi 2                }
  125. {==============================================================================}
  126.  
  127. {$IFDEF WIN32}
  128. type
  129.   PJumpBlockOpt0 = ^TJumpBlockOpt0;
  130.   TJumpBlockOpt0 = packed record
  131.     MOV_EAX_Immed_OpCode: Byte;
  132.     Self_Value: Pointer;
  133.     Jmp_OpCode: Byte;
  134.     Method_Addr: Pointer;
  135.     DummyAddr: Byte;
  136.   end;
  137.  
  138. type
  139.   PJumpBlockOpt1 = ^TJumpBlockOpt1;
  140.   TJumpBlockOpt1 = packed record
  141.     MOV_EAX_2_EDX_OpCode: Word;
  142.     MOV_EAX_Immed_OpCode: Byte;
  143.     Self_Value: Pointer;
  144.     Jmp_OpCode: Byte;
  145.     Method_Addr: Pointer;
  146.     DummyAddr: Byte;
  147.   end;
  148.  
  149. type
  150.   PJumpBlockOpt2 = ^TJumpBlockOpt2;
  151.   TJumpBlockOpt2 = packed record
  152.     MOV_EDX_2_ECX_OpCode: Word;
  153.     MOV_EAX_2_EDX_OpCode: Word;
  154.     MOV_EAX_Immed_OpCode: Byte;
  155.     Self_Value: Pointer;
  156.     Jmp_OpCode: Byte;
  157.     Method_Addr: Pointer;
  158.     DummyAddr: Byte;
  159.   end;
  160.  
  161. type
  162.   PJumpBlockOpt3 = ^TJumpBlockOpt3;
  163.   TJumpBlockOpt3 = packed record
  164.     MOV_ECX_2_ParmStore_OpCode: Word;
  165.     Parm3_Store_Address: Pointer;
  166.     POP_ECX_OpCode: Byte;
  167.     MOV_ECX_2_RetAddrStore_OpCode: Word;
  168.     RetAddr_Store_Address: Pointer;
  169.     MOV_EDX_2_ECX_OpCode: Word;
  170.     MOV_EAX_2_EDX_OpCode: Word;
  171.     MOV_ParmStore_2_EAX_OpCode: Byte;
  172.     Parm3_Store_Address2: Pointer;
  173.     PUSH_Parm3_From_EAX_OpCode: Byte;
  174.     MOV_RetAddr_2_EAX_OpCode: Byte;
  175.     RetAddr_Store_Address2: Pointer;
  176.     PUSH_RetAddr_From_EAX_OpCode: Byte;
  177.     MOV_EAX_Immed_OpCode: Byte;
  178.     Self_Value: Pointer;
  179.     Jmp_OpCode: Byte;
  180.     Method_Addr: Pointer;
  181.     DummyAddr: Byte;
  182.     { Temp storage areas for 3rd parameter and return address }
  183.     Temp_Parm3_Store: Pointer;
  184.     Temp_ReturnAddr_Store: Pointer;
  185.   end;
  186.  
  187. function MakeMethodInstance32Reg(Code,Data: Pointer; OptCount: Integer): Pointer;
  188. begin
  189.   Result := nil;
  190.   if OptCount in [0..3] then
  191.     begin
  192.       (* ORIGINAL VERSION:
  193.       Result := VirtualAlloc(nil,sizeof(TJumpBlockOpt3),MEM_COMMIT,PAGE_EXECUTE_READWRITE); *)
  194.       (*!! REVISED VERSION: *)
  195.       Result := VirtualAlloc(nil, sizeof(TJumpBlockOpt3), MEM_RESERVE or MEM_COMMIT,
  196.         PAGE_EXECUTE_READWRITE);      
  197.       if Result <> nil then
  198.         case OptCount of
  199.           0:
  200.  
  201.             With PJumpBlockOpt0(Result)^ do
  202.               begin
  203.                 MOV_EAX_Immed_OpCode := $B8;    { Move DWORD following this instruction into EAX register }
  204.                 Self_Value           := Data;   { Set DWORD to the object instance address }
  205.                 Jmp_OpCode           := $E9;    { JMP to the relative offset following this opcode }
  206.                 Method_Addr          := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  207.               end;
  208.  
  209.           1:
  210.  
  211.             With PJumpBlockOpt1(Result)^ do
  212.               begin
  213.                 MOV_EAX_2_EDX_OpCode := $D08B;  { Copy EAX register to the EDX register }
  214.                 MOV_EAX_Immed_OpCode := $B8;    { Move DWORD following this instruction into EAX register }
  215.                 Self_Value           := Data;   { Set DWORD to the object instance address }
  216.                 Jmp_OpCode           := $E9;    { JMP to the relative offset following this opcode }
  217.                 Method_Addr          := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  218.               end;
  219.  
  220.           2:
  221.  
  222.             With PJumpBlockOpt2(Result)^ do
  223.               begin
  224.                 MOV_EDX_2_ECX_OpCode := $CA8B;  { Copy EDX register to ECX register }
  225.                 MOV_EAX_2_EDX_OpCode := $D08B;  { Copy EAX register to the EDX register }
  226.                 MOV_EAX_Immed_OpCode := $B8;    { Move DWORD following this instruction into EAX register }
  227.                 Self_Value           := Data;   { Set DWORD to the object instance address }
  228.                 Jmp_OpCode           := $E9;    { JMP to the relative offset following this opcode }
  229.                 Method_Addr          := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  230.               end;
  231.  
  232.           3:
  233.  
  234.             With PJumpBlockOpt3(Result)^ do
  235.               begin
  236.                 MOV_ECX_2_ParmStore_OpCode := $0D89;
  237.                 Parm3_Store_Address := @Temp_Parm3_Store;
  238.                 POP_ECX_OpCode := $59;
  239.                 MOV_ECX_2_RetAddrStore_OpCode := $0D89;
  240.                 RetAddr_Store_Address := @Temp_ReturnAddr_Store;
  241.                 MOV_EDX_2_ECX_OpCode := $CA8B;
  242.                 MOV_EAX_2_EDX_OpCode := $D08B;
  243.                 MOV_ParmStore_2_EAX_OpCode := $A1;
  244.                 Parm3_Store_Address2 := @Temp_Parm3_Store;
  245.                 PUSH_Parm3_From_EAX_OpCode := $50;
  246.                 MOV_RetAddr_2_EAX_OpCode := $A1;
  247.                 RetAddr_Store_Address2 := @Temp_ReturnAddr_Store;
  248.                 PUSH_RetAddr_From_EAX_OpCode := $50;
  249.                 MOV_EAX_Immed_OpCode   := $B8;  { Move DWORD following this instruction into EAX register }
  250.                 Self_Value             := Data; { Set DWORD to the object instance address }
  251.                 Jmp_OpCode             := $E9;  { JMP to the relative offset following this opcode }
  252.                 Method_Addr            := Pointer(LongInt(Code) - LongInt(@DummyAddr));
  253.               end;
  254.         end;
  255.     end;
  256. end;
  257. {$ENDIF}
  258.  
  259. end.
  260.